home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / oopmous.com / BEZIER.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-02  |  8.8 KB  |  283 lines
  1. program BezierCurves;
  2. { program that demonstrates use of the mouse object and Bezier spline curves }
  3.  
  4. uses
  5.   Crt,
  6.   Graph,
  7.   MouseUnit;
  8.  
  9. const
  10.   radius = 5;                      { radius of pickup circle    }
  11.   resolution = 0.025;         { resolution of Bezier curve approximation    }
  12.  
  13. type
  14.   coordinate = record
  15.     row    : integer;
  16.     column    : integer;
  17.   end;
  18.  
  19. var
  20.   OldExitProc    : Pointer;         { Saves exit procedure address    }
  21.   last_Bezier_curve : array[1..42] of coordinate; { array size = 1 / resolution + 2 }
  22.   Bezier_fill_pointer : integer;
  23.   mouse        : mouse_object;                 { mouse object    }
  24.   MaxX, MaxY    : word;          { The maximum resolution of the screen    }
  25.   point        : array[1..4] of coordinate;   { end and control points    }
  26.  
  27. {-----------------------------------------------------------------------}
  28.  
  29. {$F+} procedure MyExitProc; {$F-}
  30. begin
  31.     ExitProc := OldExitProc;       { Restore exit procedure address    }
  32.     CloseGraph;            { Shut down the graphics system    }
  33. end; { MyExitProc }
  34.  
  35. {-----------------------------------------------------------------------}
  36.  
  37. procedure Initialize;
  38. { Initialize graphics and report any errors that may occur }
  39. var
  40.   GraphDriver    : integer;           { The Graphics device driver    }
  41.   GraphMode    : integer;              { The Graphics mode value    }
  42.   ErrorCode    : integer;          { Reports any graphics errors    }
  43.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  44.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  45.   xasp, yasp : word;
  46. begin
  47.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  48.   DirectVideo := False;
  49.   OldExitProc := ExitProc;                { save previous exit proc }
  50.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  51.   PathToDriver := 'c:\lang\bgi';
  52.   repeat
  53.  
  54. {$IFDEF Use8514}                          { check for Use8514 $DEFINE }
  55.     GraphDriver := IBM8514;
  56.     GraphMode := IBM8514Hi;
  57. {$ELSE}
  58.     GraphDriver := Detect;                { use autodetection }
  59. {$ENDIF}
  60.  
  61.     InitGraph(GraphDriver, GraphMode, PathToDriver);
  62.     ErrorCode := GraphResult;             { preserve error return }
  63.     if ErrorCode <> grOK then             { error? }
  64.     begin
  65.       Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
  66.       if ErrorCode = grFileNotFound then  { Can't find driver file }
  67.       begin
  68.         Writeln('Enter full path to BGI driver or type <Ctrl-Break> to quit:');
  69.         Readln(PathToDriver);
  70.         Writeln;
  71.       end
  72.       else
  73.         Halt(1);                          { Some other error: terminate }
  74.     end;
  75.   until ErrorCode = grOK;
  76.  
  77.   MaxX := GetMaxX;          { Get screen resolution values }
  78.   MaxY := GetMaxY;
  79.  
  80.   SetLineStyle ( SolidLn, SolidFill, NormWidth );
  81. end; { Initialize }
  82.  
  83. {-----------------------------------------------------------------------}
  84.  
  85. function adjasp(y : integer) : integer;
  86. begin
  87.     adjasp := (MaxY - y);
  88. end;
  89.  
  90. {-----------------------------------------------------------------------}
  91.  
  92. function pow(x : real; y : word) : real;
  93. { compute x to the y                            }
  94. var
  95.   count : word;
  96.   result : real;
  97. begin
  98.     result := 1;
  99.     for count := 1 to y do
  100.         result := result * x;
  101.     pow := result;
  102. end;
  103.  
  104. {-----------------------------------------------------------------------}
  105.  
  106. function within(x1, y1, x2, y2, radius : integer) : boolean;
  107. { check to see if point is within control point circle            }
  108. begin
  109.     if (sqrt(abs(sqr(x2 - x1) + sqr(y2 - y1))) <= radius) then
  110.         within := true
  111.     else
  112.         within := false;
  113. end;
  114.  
  115. {-----------------------------------------------------------------------}
  116.  
  117. procedure Bezier(t : real; var x, y : integer);
  118. { compute actual Bezier coordinates for 0 <= t <= 1 and current control    }
  119. { points.  The Bezier spline curve function is:                }
  120. {                                    }
  121. {              3             2         2           3        }
  122. {    x(t) = (1 - t) X  + 3t(1 - t) X  + 3t (1 - t)X  + t X        }
  123. {            0              1          2         3        }
  124. {                                    }
  125. {              3             2         2           3        }
  126. {    y(t) = (1 - t) Y  + 3t(1 - t) Y  + 3t (1 - t)Y  + t Y        }
  127. {            0              1          2         3        }
  128. {                                    }
  129. begin
  130.     x := round(pow(1 - t, 3) * point[1].column +
  131.         3 * t *    pow(1 - t, 2) * point[2].column +
  132.         3 * t * t * (1 - t) * point[3].column +
  133.         pow(t, 3) * point[4].column);
  134.     y := round(pow(1 - t, 3) * point[1].row +
  135.         3 * t * pow(1 - t, 2) * point[2].row +
  136.         3 * t * t * (1 - t) * point[3].row +
  137.         pow(t, 3) * point[4].row);
  138. end;
  139.  
  140. {-----------------------------------------------------------------------}
  141.  
  142. procedure EraseBezierCurve;
  143. { erase old Bezier curve stored in last_Bezier_curve array        }
  144. var x : integer;
  145. begin
  146.     moveto(last_Bezier_curve[1].column, last_Bezier_curve[1].row);
  147.     for x := 2 to Bezier_fill_pointer do
  148.         lineto(last_Bezier_curve[x].column, last_Bezier_curve[x].row);
  149. end;
  150.  
  151. {-----------------------------------------------------------------------}
  152.  
  153. procedure DrawBezierCurve;
  154. { calculate, draw and save new Bezier curve                }
  155. var
  156.     t : real;
  157.     x, y : integer;
  158. begin
  159.     Bezier_fill_pointer := 1;
  160.     moveto(point[1].column, adjasp(point[1].row));
  161.     t := 0;
  162.     while t < 1 do begin
  163.         { calculate new Bezier coordinates            }
  164.         Bezier(t, x, y);
  165.  
  166.         { draw new Bezier curve                    }
  167.         lineto(x, adjasp(y));
  168.         t := t + resolution;
  169.  
  170.         { save new coordinate for erase function        }
  171.         last_Bezier_curve[Bezier_fill_pointer].column := x;
  172.         last_Bezier_curve[Bezier_fill_pointer].row := adjasp(y);
  173.         inc(Bezier_fill_pointer);
  174.     end;
  175. end;
  176.  
  177. {-----------------------------------------------------------------------}
  178.  
  179. procedure move_point(point_index : integer);
  180. { redraw Bezier curve as a control point is moved            }
  181. var
  182.   x        : integer;
  183.   status    : integer;
  184.   mouse_row, mouse_column : integer;
  185.   old_mouse_row, old_mouse_column : integer;
  186. begin
  187.     { initialize "old" mouse positions                }
  188.     mouse.GetStatus(status, old_mouse_row, old_mouse_column);
  189.     repeat
  190.       { get mouse position                        }
  191.       mouse.GetStatus(status, mouse_row, mouse_column);
  192.  
  193.       { redraw new Bezier curve only if mouse has been moved    }
  194.       if (mouse_row <> old_mouse_row) or (mouse_column <> old_mouse_column) then begin
  195.         old_mouse_row := mouse_row;
  196.         old_mouse_column := mouse_column;
  197.  
  198.         { hide mouse while updating screen                }
  199.         mouse.Hide;
  200.  
  201.         { erase old control point and Bezier curve            }
  202.         setcolor(0);
  203.         circle(point[point_index].column, adjasp(point[point_index].row), radius);
  204.         EraseBezierCurve;            { erase old curve    }
  205.  
  206.         { set new control point coordinates                }
  207.         point[point_index].row := adjasp(mouse_row);
  208.         point[point_index].column := mouse_column;
  209.  
  210.         { draw all control points and new curve            }
  211.         setcolor(GetMaxColor);
  212.         for x := 1 to 4 do
  213.             circle(point[x].column, adjasp(point[x].row), radius);
  214.         DrawBezierCurve;
  215.  
  216.         { show mouse now that updates have been written to screen    }
  217.         mouse.Show;
  218.       end;
  219.  
  220.       { this just prevents mouse run-on when button has been released}
  221.           mouse.GetStatus(status, mouse_row, mouse_column);
  222.     until status and $01 = 0;
  223. end;
  224.  
  225. {-----------------------------------------------------------------------}
  226.  
  227. var
  228.   ch : char;
  229.   done        : boolean;
  230.   status    : integer;
  231.   button_row    : integer;
  232.   button_column : integer;
  233. begin
  234.     { check for mouse driver                    }
  235.     if not mouse.Exists then begin
  236.         writeln('Error:  this program requires the use of a mouse');
  237.         halt(1);
  238.     end;
  239.  
  240.     { initialize graphics system                    }
  241.     Initialize;
  242.  
  243.     { setup origional Bezier curve control points            }
  244.     point[1].column := MaxX - MaxX div 4;    point[1].row := MaxY div 4;
  245.     point[2].column :=  10;            point[2].row := MaxY - 10;
  246.     point[3].column := MaxX - 10;        point[3].row := MaxY - 10;
  247.     point[4].column := MaxX div 4;        point[4].row := MaxY div 4;
  248.  
  249.     { draw origional Bezier curve control points            }
  250.     circle(point[1].column, adjasp(point[1].row), radius);
  251.     circle(point[2].column, adjasp(point[2].row), radius);
  252.     circle(point[3].column, adjasp(point[3].row), radius);
  253.     circle(point[4].column, adjasp(point[4].row), radius);
  254.  
  255.     { draw origional Bezier curve                    }
  256.     DrawBezierCurve;
  257.  
  258.     { show mouse pointer                        }
  259.     if mouse.Exists then mouse.show;
  260.  
  261.     done := false;
  262.         repeat
  263.         mouse.GetStatus(status, button_row, button_column);
  264.         { if button one pushed then check if in control point    }
  265.         if status and $01 <> 0 then begin
  266.             if within(point[1].column, adjasp(point[1].row), button_column, button_row, radius)
  267.             then move_point(1);
  268.             if within(point[2].column, adjasp(point[2].row), button_column, button_row, radius)
  269.             then move_point(2);
  270.             if within(point[3].column, adjasp(point[3].row), button_column, button_row, radius)
  271.             then move_point(3);
  272.             if within(point[4].column, adjasp(point[4].row), button_column, button_row, radius)
  273.             then move_point(4);
  274.         end;
  275.  
  276.         { repeat until ESC pressed                }
  277.                 if keypressed then begin
  278.           ch := readkey;
  279.           if ch = #27 then done := true;
  280.         end;
  281.     until done;
  282. end.
  283.